home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / mips / print.lisp < prev    next >
Encoding:
Text File  |  1991-11-06  |  1.7 KB  |  52 lines
  1. ;;; -*- Package: C -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: print.lisp,v 1.8 91/07/14 03:49:26 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; $Header: print.lisp,v 1.8 91/07/14 03:49:26 wlott Exp $
  15. ;;;
  16. ;;; This file contains temporary printing utilities and similar noise.
  17. ;;;
  18. ;;; Written by William Lott.
  19.  
  20. (in-package "MIPS")
  21.  
  22.  
  23. (define-vop (print)
  24.   (:args (object :scs (descriptor-reg) :target a0))
  25.   (:results (result :scs (descriptor-reg)))
  26.   (:save-p t)
  27.   (:temporary (:sc any-reg :offset 2) v0)
  28.   (:temporary (:sc descriptor-reg :offset 4 :from (:argument 0)) a0)
  29.   (:temporary (:sc any-reg :offset lra-offset) lra)
  30.   (:temporary (:sc any-reg :offset code-offset) code)
  31.   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
  32.   (:vop-var vop)
  33.   (:generator 0
  34.     (let ((lra-label (gen-label))
  35.       (cur-nfp (current-nfp-tn vop)))
  36.       (move a0 object)
  37.       (when cur-nfp
  38.     (store-stack-tn nfp-save cur-nfp))
  39.       (inst addu nsp-tn nsp-tn -16)
  40.       (inst compute-lra-from-code lra code lra-label v0)
  41.       (inst li v0 (make-fixup "debug_print" :foreign))
  42.       (inst j (make-fixup "call_into_c" :foreign))
  43.       (inst nop)
  44.  
  45.       (align vm:lowtag-bits)
  46.       (emit-label lra-label)
  47.       (inst lra-header-word)
  48.       (inst addu nsp-tn nsp-tn 16)
  49.       (when cur-nfp
  50.     (load-stack-tn cur-nfp nfp-save))
  51.       (move result v0))))
  52.